perm filename LOOP.OLD[XX,LCS]2 blob
sn#195536 filedate 1976-01-05 generic text, type T, neo UTF8
00100 TITLE LOOP ; SUBROUTINE LOOP(I,J,L,M,N)
00200 ENTRY LOOP,FINDIT,PLACE,DPYNEW,MVBEAM,MVBX,JUGGLE,XNOTE,BAUTO
00300 ENTRY SORT2,UPDATE,NEWR,MSSLUP,LUP2,HOMER,FSCAN
00400 EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY,DL,SCM
00500 EXTERNAL SC,SCX,RRJJ,STF,ALF,POSI
00600 DEFINE FIXX(N)
00700 < JUMPGE N,.+5
00800 MOVNS N
00900 FIX N,233000
01000 MOVNS N
01100 CAIA
01200 FIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
01300 ; DIMENSION N(1)
01400 MM←1 ↔ NN←2 ↔ JK←3 ↔JT←4 ↔IEND←5 ↔A←6 ↔K←7↔ IS←10↔ IZ←11↔ R←12↔ L←13
01410 J←3 ; WHERE IS THIS USED???
01420 RC←14 ↔ NX←15 ;**** AC'S 0,1,2,3,5 ARE USED IN 'PLACE' & 'FINDIT'!!
01500 LOOP: 0 ; DO 1 NN=I+L,J+L,K
01600 MOVE 1,@4(16)
01700 SUB 1,@3(16) ; MM IS IN 1
01800 MOVE 2,@(16)
01900 ADD 2,@3(16) ;I+L -- NN, 1ST TIME
02000 MOVE 3,@1(16)
02100 ADD 3,@3(16) ;J+L
02200 MOVE 4,@2(16) ;K
02300 HRRZI 5,@5(16) ; ADR. OF N
02400 ADDI 2,-1(5) ; N(NN)
02500 ADDI 3,-1(5)
02600 JUMPL 4,LP3 ; JUMP IF NEG. INCR.
02700 HRRM 1,.+1 ; ADD IN MM
02800 LP1: MOVE 6,(2)
02900 MOVEM 6,(2) ;N(NN)=N(NN+MM)
03000 CAIGE 2,(3)
03100 AOJA 2,LP1
03200 JRA 16,6(16)
03300 LP3: HRRM 1,.+1
03400 LP2: MOVE 6,(2) ;NEG. INCR.
03500 MOVEM 6,(2)
03600 CAILE 2,(3)
03700 SOJA 2,LP2
03800 JRA 16,6(16) ; END
03900
04000 PLACE: 0 ; FUNCTION PLACE(X)
04100 ; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
04200 ; EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
04300 MOVN 2,@(16) ; PLACE=R11-ABS(RD-X)
04400 FADR 2,XRN+=3999 ;END
04500 MOVMS 2
04600 MOVE 0,.COMM.+=12 ;R11
04700 FSBR 0,2
04800 JRA 16,1(16)
04900
05000 FINDIT: 0 ; FUNCTION FINDIT(N)
05100 SETZ ; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
05200 HRRZ 1,@(16) ; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
05300 ;; HRRZI 2,PTR ; FINDIT=0
05400 ;; ADDI 1,(2) ; L=PWDS(N)
05500 ;; MOVE 2,-1(1) ; IF(RN(L+1).NE.1)GO TO 377
05600 ;; FIXX(2) ; IF(RN(L+2).EQ.R2)RETURN
05700 ;; HRRZI 3,XRN ;377 FINDIT=-1
05800 ;; ADDI 3,(2) ; END
05900 ;; MOVE 5,(3) ; RN(L+1)
06000 MOVE 2,PTR-1(1) ;THESE 3 REPLACE ABOVE
06100 ;X FIXX(2)
06200 MOVE 5,XRN(2)
06300 CAME 5,[1.0]
06400 JRST FNEG
06500 MOVEM 2,PTR+=251 ; SENDS BACK A NUM IN L
06600 ;; MOVE 5,1(3) ;RN(L+2)
06700 MOVE 5,XRN+1(2)
06800 CAME 5,.COMM.
06900 FNEG: SETO
07000 JRA 16,1(16)
07100
07200 DPYNEW: 0 ; SUBROUTINE DPYNEW
07300 JSA 16,ACCPOG ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
07400 JUMP [1] ; CALL ACCPOG(1)
07500 MOVE 2,DPY+=4251 ; IF(IGO.GT.0)RETURN
07600 JUMPG 2,DB ; CALL DPYOUT(1)
07700 JSA 16,DPYOUT ; END
07800 JUMP [1]
07900 DB: JRA 16,(16)
08000
08100 MVBEAM: 0 ;C THESE MOVE ENDS OF PARTIAL INNER BEAMS.
08200 HRRZ 2,(16) ; SUBROUTINE MVBEAM(R,I,JY,L,W)
08300 MOVE 5,@1(16) ; I
08400 ADD 2,5 ;C L AND JY ARE FOR MOVES TO DIFF. STAFF.
08500 ADD 2,@2(16) ; DIMENSION R(1)
08600 MOVE 3,-1(2) ; Y=R(JY+I)
08700 MOVM 4,3 ; Z=ABS(Y)
08800 CAMGE 4,[=100.0] ; IF(Z.LT.100.)GO TO 1
08900 JRST MV1
09000 CAML 5,[6]
09100 JRST MV1 ; IF(I.GT.5)GO TO 1
09200 ;C NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
09300 JSA 16,AMOD ; Y=AMOD(Y,100.)
09400 JUMP 3
09500 JUMP [=100.0] ; 0 HAS Y
09600 MOVE 5,@4(16) ; X=Y+W
09700 FADR 5,0
09800 MOVM 6,5 ; Z=Z-ABS(Y)+ABS(X)
09900 MOVM 7,0 ;C PUTS ALL INTO POSITIVE
10000 FSBR 4,7
10100 FADR 4,6
10200 SKIPGE 5 ; IF(X)Z=-Z
10300 MOVNS 4 ; Z
10400 JRST MV2 ; GO TO 2
10500 MV1: FADR 3,@4(16) ;1 Z=Y+W
10600 MOVE 4,3 ; Z NOW IN 4
10700 MV2: HRRZI 3,@(16) ;2 R(L+I)=Z
10800 ADD 3,@3(16)
10900 ADD 3,@1(16)
11000 MOVEM 4,-1(3) ; PUT IT IN R(L+I)
11100 JRA 16,5(16) ; END
11200
11300 MVBX: 0 ; SUBROUTINE MVBX(I)
11400 ; COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
11500 MOVE 2,@(16) ; EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
11600 ADD 2,KJY+1 ; R(L+I)=R8+(R(JY+I)-R4)*RDIS
11700 ;; HRRZI 4,XRN
11800 ;; ADDI 2,(4)
11900 ;; MOVE 3,-1(2) ; R(JY+I)
12000 MOVE 3,XRN-1(2)
12100 FSBR 3,.COMM.+5
12200 FMPR 3,.COMM.+=25 ; *RDIS
12300 FADR 3,.COMM.+=9 ; +R8
12400 MOVE 2,@(16)
12500 ADD 2,.COMM.+=24 ; + L
12600 ;; ADDI 2,(4)
12700 ;; MOVEM 3,-1(2) ;R(L+I)
12800 MOVEM 3,XRN-1(2)
12900 JRA 16,1(16)
13000
13100 JUGGLE: 0 ; SUBROUTINE JUGGLE
13200 ; IMPLICIT INTEGER(A-Z)
13300 ; REAL PWDS,RN
13400 ; COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
13500 ; COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
13600 SOS PTR+=250 ;ITEM=ITEM-1
13700 HRRZI 15,XRN ; JX=RN(MEDIT)+3 WD CNT OF OLD ITEM
13800 ;C I-IX IS WD CNT OF NEW ITEM
13900 ADD 15,DPY+=4250
14000 MOVE 14,-1(15)
14100 FIXX(14)
14200 ADDI 14,3 ; JX
14300 MOVE 13,PTR+=253 ;JY=IX
14400 MOVE 11,PTR+=252 ; I
14500 SUB 11,13
14600 SUB 11,14 ;Z=I-IX-JX SPACE CHANGE
14700 JUMPL 11,J2751 ;IF(Z)2751,172,751
14800 JUMPE 11,J172
14900 MOVE 5,PTR+=252 ;751 CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
15000 SUBI 5,1
15100 MOVE 10,DPY+=4250
15200 ADD 10,14
15300 JSA 16,LOOP
15400 JUMP 5
15500 JUMP 10
15600 JUMP [-1]
15700 JUMP 11
15800 JUMP [0]
15900 JUMP XRN
16000 ADD 13,11 ;JY=IX+Z
16100 JRST J172 ;GO TO 172
16200 J2751: ADD 14,DPY+=4250 ;2751 CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
16300 ADD 14,11
16400 MOVE 5,11
16500 ADD 5,PTR+=253
16600 SOJ 5,
16700 MOVN 10,11
16800 JSA 16,LOOP
16900 JUMP 14
17000 JUMP 5
17100 JUMP [1]
17200 JUMP [0]
17300 JUMP 10
17400 JUMP XRN
17500 ;;J172: HRRZI 12,XRN ; 172 J=RN(JY)+2
17600 ;; ADDI 12,(13) ; JY
17700 J172: MOVE 12,XRN-1(13)
17800 ;; MOVE 12,-1(12) ;RN(JY)
17900 FIXX(12)
18000 ADDI 12,2 ; J IS IN 12
18100 JSA 16,LOOP ;CALL LOOP(0,J,1,MEDIT,JY,RN)
18200 JUMP [0]
18300 JUMP 12
18400 JUMP [1]
18500 JUMP DPY+=4250 ; MEDIT
18600 JUMP 13 ; JY
18700 JUMP XRN
18800 MOVE 12,PTR+=253 ; I=IX+Z
18900 ADD 12,11 ; Z IS IN 11
19000 MOVEM 12,PTR+=252
19100 MOVE 12,PTR+=250 ; 1751 X=ITEM+1
19200 AOJ 12, ; X IS IN 12
19300 HRRZI 13,DPY+=4000 ; JX=WDS(X22+1)-WDS(X22)
19400 ADD 13,DL
19500 MOVE 14,(13) ; WDS(X22+1) IN 14 ADR. WDS(X22) IN 13
19600 SUB 14,-1(13) ;JX IN 14
19700 HRRZI 10,DPY+=4000 ; J=WDS(X+1)-WDS(X)
19800 ADDI 10,(12)
19900 MOVE 7,(10) ;WDS(X+1)
20000 SUB 7,-1(10) ;J IN 7
20100 MOVEM 7,MVBX ; STORE J
20200 SUB 7,14 ; Y=J-JX
20300 MOVE 14,-1(10) ; JX=WDS(X)+Y+1
20400 ADD 14,7
20500 AOJ 14, ; JX IN 14
20600 JUMPL 7,J2851 ; IF(Y)2851,182,282
20700 JUMPE 7,J182
20800 MOVE 15,(10) ;282 CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
20900 ADDI 15,2 ; ARG 1
21000 MOVE 6,-1(13) ; ARG 2
21100 JSA 16,LOOP
21200 JUMP 15
21300 JUMP 6
21400 JUMP [-1]
21500 JUMP 7 ; Y
21600 JUMP [0]
21700 JUMP DPY
21800 JRST J182 ; GO TO 182
21900 J2851: MOVE 14,(13) ;2851 CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
22000 ADD 14,7 ;+Y
22100 ADDI 14,1 ; ARG 1
22200 MOVE 5,-1(10) ;WDS(X)
22300 ADD 5,7
22400 ADDI 5,1 ; ARG 2
22500 MOVNM 7,MVBEAM ; -Y IS STORED
22600 JSA 16,LOOP
22700 JUMP 14
22800 JUMP 5
22900 JUMP [1]
23000 JUMP [0]
23100 JUMP MVBEAM
23200 JUMP DPY
23300 MOVE 14,-1(10) ; WDS(X) JX=WDS(X)+1
23400 ADDI 14,1 ; JX IN 14
23500 J182: MOVE 5,-1(13) ;182 CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
23600 ADDI 5,1 ;WDS(X22)+1
23700 JSA 16,LOOP
23800 JUMP [1]
23900 JUMP MVBX
24000 JUMP [1]
24100 JUMP 5
24200 JUMP 14
24300 JUMP DPY
24400 MOVE 2,DL ; DO 183 K=X22+1,X
24500 ;; HRRZI 5,DPY+=4000 ; 183 WDS(K)=WDS(K)+Y
24600 ;; ADD 5,2
24700 HRRZI 3,PTR
24800 ADDI 3,(2)
24900 ;; TLC 11,232000 ; FLOAT Z
25000 ;; FADR 11,11
25100 J183: JUMPE 11,J184 ;IF(Z.EQ.0)GO TO 184
25200 ADDM 11,(3) ; PWDS(K)=PWDS(K)+Z
25300 AOJ 3, ;UPDATE PWDS AND WDS
25400 J184: JUMPE 7,J185
25500 ADDM 7,(13)
25600 AOJ 13,
25700 J185: CAIGE 2,(12)
25800 AOJA 2,J183
25900 ;; HRRZI 2,DPY+=4000 ;ST(2)=WDS(X)
26000 ;; ADDI 2,(12) ;WDS(X+1) ADR.
26100 ;; MOVE 2,-1(2)
26200 MOVE 2,DPY+=3999(12)
26300 ;; HRRZI 3,DPY
26400 ;; MOVEM 2,1(3)
26500 MOVEM 2,DPY+1
26600 SETZM DL ;X22=0
26700 JRA 16,(16)
26800
26900 SORT2: 0 ;SUBROUTINE SORT2(RPOS,M)
27000 MOVEI 2,2 ;DIMENSION RPOS(2,200)
27100 S3: MOVE 6,2 ;(K=L HERE)
27200 SETO 11, ;L=2
27300 HRRZI 3,@(16) ;3 J=-1
27400 MOVE 4,2 ;RX=RPOS(1,L-1)
27500 SUBI 4,1 ;L-1
27600 IMULI 4,2
27700 ADDI 4,(3)
27800 MOVE 5,-2(4) ;RX
27900 S2: MOVE 7,6 ; DO 2 K=L,M
28000 ;; LSH 7,1 ;IF(RPOS(1,K).GE.RX)GO TO 2
28100 IMULI 7,2 ;IF(RPOS(1,K).GE.RX)GO TO 2
28200 ADDI 7,(3)
28300 CAMG 5,-2(7)
28400 JRST S1 ; CONTINUE
28500 MOVE 5,-2(7) ; RX=RPOS(1,K)
28600 ;;C WHY WERE ALL THE RX'S JX ????? 9/6/73
28700 MOVE 11,6 ;J=K
28800 S1: CAMGE 6,@1(16) ;2 CONTINUE
28900 AOJA 6,S2
29000 JUMPL 11,S4 ;IF(J)GO TO 4
29100 MOVE 12,2 ;K=L-1
29200 SOS 12
29300 IMULI 12,2 ;(K*2)
29400 ADD 12,3 ;CALL EXCH(RPOS(1,K),RPOS(1,J))
29500 MOVE 10,-2(12)
29600 ;; LSH 11,1 ;MULTS BY 2 (LEFT SHIFT)
29700 IMULI 11,2
29800 ADD 11,3
29900 EXCH 10,-2(11)
30000 MOVEM 10,-2(12)
30100 MOVE 10,-1(12) ;CALL EXCH(RPOS(2,K),RPOS(2,J))
30200 EXCH 10,-1(11)
30300 MOVEM 10,-1(12)
30400 S4: CAMGE 2,@1(16) ;4 L=L+1
30500 AOJA 2,S3 ;IF(L.LE.M)GO TO 3
30600 JRA 16,2(16) ;END
30700
30800 XNOTE: 0 ;FUNCTION XNOTE(J)
30900 MOVE 3,@(16) ;COMMON/XRN/RN(4000)
31000 IMULI 3,12 ;DIMENSION R(10,80)
31100 ;; ADDI 3,XRN+=2993 ;EQUIVALENCE (R,RN(3001))
31200 ;; MOVE 2,(3) ;XNOTE=AMOD(R(4,J),100.)
31300 MOVE 2,XRN+=2993(3)
31400 JSA 16,AMOD
31500 JUMP 2
31600 JUMP [=100.0]
31700 JRA 16,1(16) ;END
31800
31900 BAUTO: 0 ; SUBROUTINE BAUTO(J,L,K,N)
32000 ;C FOR AUTOMATIC BEAMS.
32100 MOVEI 2,2 ;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
32200 ADDB 2,@(16) ;J=J+2
32300 MOVE 3,@3(16)
32400 MOVE 4,@1(16)
32500 SUB 4,3 ;L-N
32600 MOVE 5,@2(16)
32700 SUB 5,3 ;K-N
32800 ;; HRRZI 6,SCM
32900 ;; ADDI 6,(2)
33000 TLC 4,232000
33100 FADR 4,4 ;FLOATS IT
33200 ;; MOVEM 4,-2(6) ;V(J-1)=L-N
33300 MOVEM 4,SCM-2(2)
33400 TLC 5,232000
33500 FADR 5,5 ;FLOATS IT
33600 ;; MOVEM 5,-1(6) ;V(J)=K-N
33700 MOVEM 5,SCM-1(2)
33800 JRA 16,4(16)
33900
34000 UPDATE: 0 ; SUBROUTINE UPDATE(I)
34100 ;; HRRZI 3,XRN ;COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
34200 ;; ADD 3,PTR+=252 ;RN(IS)=I
34300 MOVE 3,PTR+=252
34400 MOVE 2,@(16)
34500 TLC 2,232000 ;FLOAT I
34600 FADR 2,2
34700 ;; MOVEM 2,-1(3)
34800 MOVEM 2,XRN-1(3)
34900 ;; MOVE 2,PTR+=252
35000 ;; ADD 2,@(16)
35100 ;; ADDI 2,3
35200 ;; MOVEM 2,PTR+=252 ;IS=IS+I+3
35300 MOVE 2,@(16)
35400 ADDI 2,3
35500 ADDM 2,PTR+=252
35600 JRA 16,1(16)
35700
35900 IK: 0
36000 JIT: 0 ; THESE ARE TO STORE PNTRS IN LOOP
36100 NEWR: 0 ; SUBROUTINE NEWR
36200 MOVE A,SC+=70 ;COMMON/PTR/PWDS(250),ITEM,LL,IS,IX
36300 CAIE A,1 ;COMMON/XRN/RN(4000)
36400 JRST N1 ;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
36500 MOVE JK,PTR+=252;COMMON/SCX/RHY(4),JALPHA(30),JX,U,JZ,IRHY,J4,KA,KB,IZ
36600 MOVEM JK,IK ;1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
36700 MOVE JT,PTR+=250 ;1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
36800 MOVEM JT,JIT ;DIMENSION R(10,80)
36900 N1: MOVE IS,IK ;EQUIVALENCE (R,RN(3001))
37000 MOVEM IS,PTR+=252
37100 MOVE 14,[9999.0]
37200 MOVE JT,JIT ;IF(MODE.NE.1)GO TO 1
37300 ADDI JT,1 ;IK=IS
37400 MOVEM JT,PTR+=250 ;JIT=ITEM
37500 MOVEI K,=10 ;1 IS=IK
37600 MOVE IZ,SCX+=41 ;ITEM=JIT+1 ******************** WAS +=33
37700 IMULI IZ,=10 ;MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
37800 ;;N2: HRRZI R,XRN+=2997 ;DO 2 K=1,IZ
37900 ;;;;N2: MOVE R,XRN+=2997(K) ;DO 2 K=1,IZ
38000 ;; ADD R,K ;IF(R(8,K).EQ.9999.)GO TO 2
38100 ;; MOVE R,(R)
38200 ;;;; CAMN R,[=9999.0]
38300 N2: CAMN 14,XRN+=2997(K)
38400 JRST NN2 ;SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
38500 SETO IEND, ;C JUMP FOR BEAM CONT.
38600 ;; HRRZI L,XRN ;IEND=-1
38700 ;; ADD L,PTR+=252 ;RN(IS+3)=0
38800 ;; SETZM 2(L)
38900 ;; SETZM 1(L) ;RN(IS+2)=0
39000 MOVE L,PTR+=252
39100 SETZM XRN+2(L)
39200 SETZM XRN+1(L)
39300 MOVEI L,=9 ;C ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
39400 ;;N3: HRRZI R,XRN+=3000 ;DO 3 L=9,1,-1
39500 N3: HRRZI R,XRN+=3000(K) ;DO 3 L=9,1,-1
39600 ;; ADDI R,(K) ;A=R(L,K)
39700 ADDI R,(L)
39800 MOVE A,-13(R) ;(OCTAL)=-11
39900 JUMPGE IEND,NX4 ;IF(A.NE.0)GO TO 77
40000 JUMPN A,NX3 ;IF(IEND)GO TO 3
40100 JRST NN3
40200 NX3: MOVE IEND,L ;77 IF(IEND)IEND=L
40300 ;;NX4: HRRZI R,XRN
40400 ;; ADD R,PTR+=252 ;RN(IS+L)=A
40500 ;; ADDI R,(L)
40600 ;; MOVEM A,-1(R)
40700 NX4: MOVE R,PTR+=252
40800 ADDI R,(L)
40900 MOVEM A,XRN-1(R)
41000 NN3: CAILE L,1 ;3 CONTINUE
41100 SOJA L,N3
41200 CAIGE IEND,3
41300 MOVEI IEND,3
41400 MOVE 15,IEND ;IF(IEND.LT.3)IEND=3
41500 SUBI 15,2
41600 JSA 16,UPDATE ;CALL UPDATE(IEND-2)
41700 JUMP 15
41800 NN2: CAML K,IZ ;2 CONTINUE
41900 JRA 16,(16) ;END
42000 ADDI K,=10
42100 JRST N2
42200
42300 CNT: 0
42400 MSSLUP: 0
42500 SETZ 1, ;161 CNT=1
42600 SETZ 2,
42700 L5543: MOVE 3,.COMM.+4(2) ;DO 5543 K=1,9
42800 ;; ADDI 3,(2)
42900 ;; MOVE 3,(3) ;RA=RJQ(K)
43000 SKIPE 3 ;IF(RA.NE.0)CNT=K
43100 MOVE 1,2
43200 ;; MOVEI 4,RRJJ+1 ;5543 RJJ(K)=RA
43300 ;; ADDI 4,(2)
43400 ;; MOVEM 3,(4)
43500 MOVEM 3,RRJJ+1(2)
43600 CAIG 2,7 ; LOOP BACK?
43700 AOJA 2,L5543
43800 AOJ 1,
43900 MOVEM 1,CNT ;REMEMBERS CNT
44000 JRA 16,(16)
44100
44200 LUP2: 0
44300 ;; MOVEI 1,XRN ;261 RN(I)=CNT
44400 ;; ADD 1,PTR+=252
44500 MOVE 2,CNT
44600 TLC 2,232000
44700 FADR 2,2 ;FLOATS IT
44800 ;; MOVEM 2,-1(1)
44900 MOVE 1,PTR+=252
45000 MOVEM 2,XRN-1(1)
45100 MOVE 2,.COMM.+1 ;RN(I+1)=JA
45200 TLC 2,232000
45300 FADR 2,2
45400 ;; MOVEM 2,(1)
45500 ;; MOVE 2,PTR+=252 ;I=I+2
45600 ;; ADDI 2,2
45700 ;; MOVEM 2,PTR+=252
45800 MOVEM 2,XRN(1)
45900 ADDI 1,2
46000 MOVEM 1,PTR+=252
46100 MOVE 3,.COMM. ;RN(I)=R2
46200 ;; MOVEM 3,1(1)
46300 MOVEM 3,XRN-1(1)
46400 ;; NOT USED NOW! IF(RD.NE.0)RN(I)=RD
46500 ;;C TO SAVE NOTE NUMBS IN P2.
46600 SETZ 5, ;DO 4554 K=1,CNT
46700 L4554: MOVE 2,.COMM.+4(5)
46800 ;;L4554: MOVEI 2,.COMM.+4 ;(RJQ)
46900 ;; ADDI 2,(5)
47000 ;; MOVE 2,(2)
47100 ;; MOVEI 3,XRN(5)
47200 ;; ADDI 3,(5)
47300 ;; ADD 3,PTR+=252
47400 ;; MOVEM 2,(3) ;4554 RN(I+K)=RJQ(K)
47500 MOVE 3,1
47600 ADDI 3,(5)
47700 MOVEM 2,XRN(3)
47800 AOJ 5,
47900 CAME 5,CNT
48000 JRST L4554
48100 AOJ 5,
48200 ;; ADD 5,PTR+=252
48300 ADDM 5,PTR+=252
48400 ;; MOVEM 5,PTR+=252 ;3554 I=CNT+1+I
48500 JRA 16,(16)
48600
48800 ;;C****** FOR 'HOOiNG' OF BEAMS AND CHORD NOTES ***********
48900 ;; SUBROUTINE HOMER
49000 ;; IMPLICIT INTEGER(A-Q,S-Z)
49100 ;; REAL PWDS,DISX,A,B,PLACE,STFF
49200 ;; COMMON /STF/RSTFAC(-3/4),RSTJ2
49300 ;; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
49400 ;; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
49500 ;; COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
49600 ;; EQUIVALENCE (R3,RJQ(1)),(R6,RJQ(4)),(J11,JQ(9)),(RD,RN(4000))
49700 ;; 1,(R7,RJQ(5)),(R9,RJQ(7)),(R11,RJQ(9)),(R13,RJQ(11))
49800 ;; 1,(J10,JQ(8)),(R8,RJQ(6)),(J7,JQ(5))
49900 HOMER: 0 ; IF(JA.EQ.6)GO TO 9
50000 MOVE MM,.COMM.+1
50100 CAIN MM,6
50200 JRST H9
50300 SKIPE .COMM.+=14 ;IF(R13.NE.0)GO TO 10
50500 JRST H10 ; FOR GENL HOMING; WORDS; BEAMS; STEMS;
50550 SETZM ALF+1 ; FLAG LATER ON
50600 SKIPN .COMM.+=24 ;IF(JQ(1).EQ.0)GO TO 197
50700 JRST H197 ; TO HOME IN ON NOTE ON DIFFERENT STAFF.
50800
50810 MOVE PTR+=250 ;JJ2=ITEM (FOR RETURN WITH NO CHANGE)
50820 MOVEM POSI+=8
50900 ; IF(JA.EQ.6)GO TO 9
51000 SETOM ALF+1 ; FLAG FOR DIFF. STAVES
51100 MOVE K,.COMM. ;JJ2=R2
51200 FIXX(K)
51300 ; JJ2 FOR RUNTHR
51400 MOVE K,PTR-1(K) ;K=PWDS(JJ2) ← BEAM PTR.
51500 MOVE XRN(K)
51600 CAME [6.0] ; IS IT REALLY A BEAM?
51700 JRA 16,(16) ;NO - GO BACK
51800 ;******* 19, ITEM# OF BEAM, +1 FOR STAFF ABOVE, -1 FOR BELOW.
51900 MOVE R,XRN+5(K)
52000 SETZ MM, ; 0=BEAM STEM ↓
52100 MOVE XRN+6(K) ;RN(K+7) STEM DIR.
52200 CAMGE [20.0] ;IS IT UP?
52300 SETO MM, ; YES -1=BEAM STEM ↑
52310 MOVE A,XRN+1(K) ;SAVE BEAM'S STAFF #
52320 MOVEM A,ALF+8
52500 MOVE .COMM.+4 ; 2ND PARAM
52510 CAMN [0.1] ; USE .1 FOR SAME STAFF
52520 SETZ
52530 FADR A,
52600 ;; CAMLE 5,[4.0] ;.GT.4 =0
52700 ;; SETZ 5,
52800 ;; MOVEM 5,ALF+5 ; SAVE NOTES' STAFF #
52810 MOVEM A,ALF+5 ; SAVE NOTES' STAFF #
52900 SETZ L, ; NEXT IS SEARCH LOOP
52910 MOVE IZ,[1.0]
53000 H401: MOVE 3,PTR(L) ; 3=KWDS(L)
53100 CAMN 5,XRN+1(3) ;IF RN(3).NE.STF, SKIP
53110 JRST .+3
53120 CAME A,XRN+1(3) ; LOOKS ON BOTH STAVES FOR END NOTE OF BEAM
53200 JRST H402
53300 CAME IZ,XRN(3) ; IS IT A NOTE?
53400 JRST H402 ; NO
53500 MOVE XRN+2(3) ;POS OF NOTE
53600 FSBR R ; NOTE POS - RT. SIDE OF BEAM
53700 MOVM ; ABS. VALUE
53800 CAMG [2.5] ; + OR - 2.5 RANGE FOR HOMING
53900 JRST H403 ; NO CLOSE ENOUGH
54000 H402: AOJ L, ; ADD ONE FOR LOOP
54100 CAMGE L,PTR+=250 ; UP TO ITEM YET?
54200 JRST H401
54210
54300 JRA 16,(16) ;COULDN'T HOME IN.
54400 H403: MOVE L,PTR(L) ; PTR TO RIGHT NOTE
54500 MOVEI JK,XRN(L) ; (RB) PTR TO NOTE
54600 MOVE 2(JK)
54700 MOVEM ALF+=19 ;SAVE PTR TO POS OF NOTE IN ALF+=19.
54800
54900 ;L=PWDS(JQ(1)) ← NOTE PTR.
55000 ;RA=RN(K+3)
55100 ;SAVE LOC OF RN(K+1)
55200 ;RB=RN(L+3)
55300 MOVM RC,3(JK) ; RN(L+4)
55400 MOVE NX,[1.0]
55500 ;; SKIPGE RC
55600 ;; MOVNS RC
55700 CAMGE RC,[90.0]
55800 JRST .+2 ;*******************
55900 MOVE NX,[0.6] ; FOR MINI NOTES AND BEAMS
56000 ;; MOVE RC,[0.7] ;FOR MINI STEM
56100 ;; SKIPA
56200 ;; MOVE RC,[1.0]
56300 H400: MOVEM JK,ALF+=20 ;LOC OF RN(L+1)
56400 ;N MOVE IZ,2(JK) ; RB=POS OF NOTE, RA=POS(P3) OF BEAM
56500 SETZM ALF+=17 ;N=0
56600 MOVE 0,4(JK) ;IF(RN(L+5).LT.20)N=-1
56700 CAMGE 0,[=20.0]
56800 SETOM ALF+=17 ; -1 MEANS NOTE'S STEM IS UP
56900 MOVN 0,XRN+6(K) ;RG=-(AMOD(RN(K+7),10.)-1.)[*NX]*11./7.
57000 MOVEM 0,ALF+=13 ;RN(K+7)
57100 MOVEM MM,ALF+=21 ;SAVE IT 'TIL AFTER AMOD
57200 JSA 16,AMOD
57300 JUMP ALF+=13
57400 JUMP [=10.0]
57500 FADR 0,[=1.0]
57600 FMPR 0,[=1.5714]
57700 FMPR 0,NX ; *RMINI (.6)
57800 MOVEM 0,ALF+=15 ;RG SAVED IN ALF+=15
57900 ; VERTICAL SPACE FOR THE NUMB. OF BEAMS
58000 MOVE MM,ALF+=21 ;GET BACK STEM DIR.
58100 MOVE L,ALF+=20 ;JT=RN(L+2) ←STAFF # OF NOTE
58200 MOVE JT,1(L)
58300 FIXX(JT) ; JT IS IN JT
58400 ;; MOVE JK,XRN+1(K) ;JK=RN(K+2) ←STAFF # OF BEAM
58500 ;; MOVEM JK,ALF+=8 ; SAVE BEAM'S STAFF #
58510 MOVE JK,ALF+8 ;GET BEAM'S STAFF #
58600 FIXX(JK) ; JK IS IN JK
58700 ; THE STAFF NUMS. JK=BEAM JT=NOTE
58800 MOVE IS,STF+3(JK) ;R3=RSTFAC(JK) R3 IS IN 'IS'
58900 FMPR IS,NX ; *RMINI (.6)
59000 ;; MOVE IZ,STF+3(JT) ;R9=RSTFAC(JT)/R3
59100 FMPR IS,[=2.43959732] ;R8=R3*14.54/5.96
59200 MOVEM IS,ALF+=14
59300 ; R8=WIDTH OF NOTE
59400
59500 ; ALF+=14= IS = WIDTH OF NOTE -- NEEDED BECAUSE OF DIFF. STEM DIRECTIONS.
59600
59700
59800 ;******* 5/74 BOTH STAVES MUST BE SAME SIZE - MOST LALF+=19ELY ********
59900 CAME MM,ALF+=17 ;3 IF(M.NE.N)GO TO 5
60000 JRST H5 ; JUMP IF STEMS GO DIF. DIRECTIONS
60100 SETZ IS, ;R8=0 NOTE WIDTH
60200 SETZM ALF+=14 ; ALSO NOTE WIDTH
60300 SETO MM, ;REVERSE STEM DIR. BECAUSE IT'S REVERSED LATER
60400 SKIPE ALF+=17
60500 SETZ MM,
60600 MOVEM MM,ALF+=17
60700 SETZM ALF+=15 ;RG=0 VERT SPACE FOR # OF BEAMS
60800 SETZ IZ,
60900 JRST H4 ;GO TO 4N
61000 H5: SKIPE MM ;5 IF(M.EQ.0)GO TO 4N
61100 MOVNS IS ;R8=-R8
61200 MOVE IZ,[13.71428571] ;=96/2 DBL STNDRD STEM LNGTH + CRAP
61300 FMPR IZ,NX ; *RMINI (.6 -- FOR MINI-NOTES)
61400
61500 ; NOT OK IF DIFF SIZES AND RA.GT.RB ****** 5/74
61600 H4: FADR IS,ALF+=19 ;4 RN(K+6)=RB+R8
61700 MOVEM IS,XRN+5(K) ;SETS CORRECT HORIZONTAL PARAM OF BEAM.
61800 MOVE [=7.0] ; AC0=SPACE FOR ONE DIATONIC STEP(VERTICAL)
61900 FMPR STF+3(JK) ; *STAFF SIZE FACTOR RF=7.*R9
62000 MOVE NN,POSI+3(JT)
62100 FSBR NN,POSI+3(JK) ; RE=(STFF(JT)-STFF(JK))/RF
62200 FDVR NN,0 ; DIST BETWEEN STAVES.
62300 MOVM NN,NN
62400 FSBR IZ,NN ;SUBTRAC. DBL STEM LNGTH FROM DIFF BETWEEN STAVES.
62500 ;MAKE DIFF BETWEEN STAVE ALWAYS POS.
62600 FADRM IZ,ALF+=15 ;" SPACE FOR MULTIPLE BEAMS, PUT IT IN ALF+=15
62700 ;; MOVMS ALF+=15 ; ALF+=15 HAS SPACE DIFFERENCE IN VERT. NOTE SPACES.
62800 SKIPN MM
62900 MOVNS ALF+=15
63000 MOVE JK,MM
63100 CAMN MM,ALF+=17 ; BOTH STEMS SAME DIR.?
63200 MOVNS ALF+=15 ; YES
63300 MOVEI MM,2
63400 SKIPN JK
63500 MOVEI MM,1 ; -1 BECOMES 2, 0 BECOMES 1.
63600 MOVEM MM,ALF ;REVERSES STEM DIR. FOR LATER USE. SAVES IN ALF
63700
63800 ;; IS=NOTE WIDTH, ALF+=15 =DIST. BETWEEN STAVES, +HGT OF BEAM GROUP ETC.
63900 ;; LEFT=LEFT SIDE OF BEAM, RIGHT=RIGHT SIDE
64000
64100
64200
64300 ; NEXT ADJUSTS STEMS WHEN BEAMS ARE USED.
64400 H197: MOVE PTR+=250 ;197 JJ2=ITEM
64500 MOVEM POSI+=8
64600 MOVE R,.COMM. ;R3=R2
64700 MOVEM R,ALF+=16
64800 SETZ K, ;DO 191 K=1,ITEM
64900 SKIPN ALF+1 ; JUMP TO H191 IF DOING ORDINARY HOMING.
65000 JRST H191
65100 MOVE K,.COMM.
65200 FIXX(K)
65300 SOJ K, ; NOW WE LOOK AT ONLY ONE BEAM (FOR DIFF. STAVES.)
65400 MOVE ALF+=8 ; GET BACK STAFF # OF BEAM
65500 MOVEM ALF+=16
65600 H191: MOVEM K,ALF+=11 ;SAVE K L=PWDS(K)
65700 MOVE L,PTR(K) ; L IS PWDS(K+1)
65800 ;IF(RN(L+1).NE.6)GO TO 191
65900 MOVEI R,XRN(L)
66000 MOVE A,(R)
66100 CAME A,[=6.0]
66200 JRST HX191
66300 MOVE JK,ALF+=16 ;IF(RN(L+2).EQ.R3)GO TO 77
66400 CAMN JK,1(R)
66500 JRST H77
66600 CAMGE JK,[=5.0] ;IF(R3.LT.5.)GO TO 191
66700 JRST HX191 ; TYPE 19 99 FOR ALL STAVES
66800 H77: MOVE JK,-1(R) ;77
66900 CAMN JK,[=8.0] ;IF(RN(L).EQ.8)GO TO 191
67000 JRST HX191
67100 MOVE JK,6(R) ;IF(RN(L+7).LT.10.)GO TO 191
67200 CAMGE JK,[=10.0] ;C FINDS BEAMS.
67300 JRST HX191
67400 FDVR JK,[=10.0] ;X=RG/10.
67500 FIXX(JK) ;C STEM DIRECT.
67600 MOVEM JK,ALF+=19 ;X SAVED IN ALF+=19
67700 MOVE JK,1(R) ;R2=RN(L+2)
67800 MOVEM JK,.COMM. ; USED IN 'FINDIT'
67900 MOVE A,2(R) ;A=RN(L+3)-.01
68000 FSBR A,[=0.01]
68100 MOVEM A,ALF+=20 ;SAVE A IN ALF+=20
68200 MOVE JK,5(R) ;B=RN(L+6)+.01
68300 FADR JK,[=0.01] ;C POS 1 AND 2
68400 MOVEM JK,ALF+=12 ;B SAVED IN ALF+=12
68500 FSBR JK,A ;DISX=B-A
68600 MOVEM JK,ALF+=18 ;DISX SAVED IN ALF+=18
68700 ; DISTANCE IN REAL STEPS
68800 MOVEM R,ALF+7 ;SAVE LOC OF RN(L+1)
68900 MOVE 0,3(R)
69000 MOVEM 0,ALF+=17
69100 JSA 16,AMOD ;RF=AMOD(RN(L+4),100.0)
69200 JUMP ALF+=17
69300 JUMP [=100.0]
69400 MOVEM 0,ALF+=17 ; THIS IS RF!!!!
69500 ; NOTE 2
69600 MOVE JK,ALF+7
69700 MOVE JK,4(JK)
69800 MOVEM JK,ALF+7
69900 JSA 16,AMOD ;RB=AMOD(RN(L+5),100.0)
70000 JUMP ALF+7
70100 JUMP [=100.0] ;0 WILL HAVE RB!!!
70200 FSBR 0,ALF+=17
70300 MOVEM 0,ALF+=9 ;RD SAVED IN ALF+=9 -- RD=RB-RF
70400 SKIPL ALF+1 ;BEAM TO OTHER STAFF?
70500 JRST H192-1 ; NO
70600 MOVE MM,ALF ; RESETS STEM DIR FOR NOTE COMPARISON.
70700 MOVEM MM,ALF+=19
70800 MOVE ALF+5 ; STAFF # FOR NOTES
70900 MOVEM .COMM. ; FOR 'FINDIT'
71000 SOJ MM,
71100 MOVE ALF+=14 ; KEEP IT IN AC0 FOR A MINUTE
71200 H3: JUMPN MM,H1 ; JUMP IF STEM OF BEAM IS DOWN
71300 MOVN ALF+=14 ; SUBTR. ALF+=14 FROM RIGHT SIDE POS.
71400 FADRM ALF+=18 ; ADD TO TOTAL BEAM LENGTH
71500 MOVN ALF+=14 ; SUBTR. ALF+=14 FROM RIGHT SIDE POS.
71600 FADRM ALF+=12
71700 JRST H2
71800
71900 H1: FADRM ALF+=12 ; OPPOSITE OF ABOVE
72000 MOVE ALF+=14
72100 FADRM ALF+=18
72200 H2: MOVE ALF+=15 ; ADD TO HGT OF LEFT SIDE OF BEAM FOR STAFF DIFF.
72300 FADRM ALF+=17 ; PUT IT AWAY
72400 MOVEI NX,1
72500 ;;H192: MOVEM NX,DPYNEW ; DO 192 N=1,ITEM
72600 H192: JSA 16,FINDIT ;IF(FINDIT(N))GO TO 192
72700 JUMP NX
72800 JUMPL 0,HX192
72900 MOVEI R,XRN ;IF(RN(L).EQ.8)GO TO 192
73000 ADD R,PTR+=251 ;LOC OF RN(L+1)
73100 MOVE JK,-1(R)
73200 CAMN JK,[=8.0]
73300 JRST HX192
73400 MOVE JK,7(R) ;IF(RN(L+8).EQ.1000.)GO TO 192
73500 CAMN JK,[=1000.0]
73600 JRST HX192 ; SKIPS SLASHED GRACE NOTES (P8=1000 OR P10=1)
73700 ; FINDIT IS NEG. IF(RN(L+1).NE.1.OR.RN(L+3))
73800 MOVE A,2(R) ;RC=RN(L+3)
73900 CAMGE A,ALF+=20 ;IF(RC.LT.A)GO TO 192
74000 JRST HX192
74100 CAMLE A,ALF+=12 ;IF(RC.GT.B)GO TO 192
74200 JRST HX192 ; WHAT'S LEFT IS IN BEAM AREA IF STEM DIR. IS OK.
74300 MOVE JK,4(R) ;IF(X.NE.IFIX(RN(L+5)/10.))GO TO 192
74400 FDVR JK,[=10.0]
74500 FIXX(JK)
74600 CAME JK,ALF+=19
74700 JRST HX192
74800 FSBR A,ALF+=20 ;RC=RC-A
74900 MOVEM A,ALF+6 ;SAVES RC
75000 MOVEM R,ALF+7 ;SAVE LOC OF RN(L+1)
75100 MOVE 0,3(R)
75200 MOVEM 0,ALF+5
75300 JSA 16,AMOD ;193 RE=AMOD(RN(L+4),100.0)
75400 JUMP ALF+5
75500 JUMP [=100.0]
75600 MOVEM 0,ALF+3 ;RE SAVE HERE
75700 MOVE JK,ALF+=9 ;RC=RD*RC/DISX+RF
75800 FMPR JK,ALF+6 ;*RC
75900 FDVR JK,ALF+=18 ;/DISX
76000 FADR JK,ALF+=17 ;+RF
76100 MOVEM JK,ALF+6 ;RC=
76200 MOVE JK,ALF+7
76300 MOVE JK,6(JK) ;RG=RN(L+7)
76400 MOVEM JK,ALF+4 ;SAVE RG
76500 JSA 16,AMOD ;RN(L+7)=RG-AMOD(RG,10.0)+AMOD(RG,1.0)
76600 JUMP ALF+4
76700 JUMP [=10.0]
76800 MOVEM 0,ALF+=10
76900 JSA 16,AMOD
77000 JUMP ALF+4
77100 JUMP [=1.0]
77200 FSBR 0,ALF+=10
77300 FADR 0,ALF+4
77400 MOVE L,ALF+7
77500 MOVEM 0,6(L) ;DELETES TAILS WITHOUT REMOVING DOTS OR SPACING OF DOTS.
77600 ; FRACTIONAL NOTE #
77700 MOVE R,ALF+6 ;195 RA=RC-RE
77800 FSBR R,ALF+3
77900 MOVE JK,ALF+=19 ;IF(X.EQ.2)RA=-RA
78000 CAIN JK,2
78100 MOVNS R
78200 SKIPN R ;IF(RA.EQ.0)RA=999.
78300 MOVE R,[=999.0]
78400 MOVEM R,7(L) ;196 RN(L+8)=RA
78500 ; FRACTIONAL NOTE # - FIRST NOTE OF GROUP + THIS NOTE # ALL *7.
78600 CAMGE NX,POSI+=8 ;IS THIS A LOWER ITEM NUMB. (FOR 2-PASS SYS)
78700 MOVEM NX,POSI+=8 ; SAVES # OF LOWEST ITEM FOUND
78800 HX192: CAMGE NX,PTR+=250 ;192 CONTINUE
78900 AOJA NX,H192
79000 HX191: MOVE K,ALF+=11 ;191 CONTINUE
79100 SKIPE ALF+1 ; WERE WE LOOKING AT BEAM TO OTHER STAFF?
79200 JRST H6 ; YES
79300 CAMGE K,PTR+=250
79400 AOJA K,H191
79500 JRA 16,(16) ;RETURN
79600
79700 H6: SKIPLE ALF+1 ; HAS THE FLAG BEEN CHANGED
79800 JRA 16,(16)
79900 MOVEM K,ALF+1 ; PUT ANY POS NUM IN IT.
80000 MOVE ALF+=8 ; GET STAFF NUM OF BEAM
80100 MOVEM .COMM. ; PUT IT BACK IN R2
80200 JRST H191 ;GO BACK TO CHECK OTHER STAFF'S STEMS.
80300
80400 H9: SKIPGE .COMM.+=32 ;9 IF(J11.LT.0)RETURN
80500 JRA 16,(16) ; IF P11=-1 NO HOMING
80600 MOVE R,.COMM.+=8 ; X=R7/10.
80700 FDVR R,[=10.0]
80800 FIXX(R)
80900 SKIPGE R ;IF(X)X=-X
81000 MOVNS R
81100 MOVEM R,IK ;X SAVED IN IK
81200 ; X IS STEM DIRECTION
81300 MOVE L,.COMM.+=10 ;RA=R9
81400 ; R9= POS3
81500 MOVNI RC,1 ;RC=-1
81600 SKIPE L ;IF(R9.NE.0)RC=-2
81700 MOVNI RC,2
81800 MOVE JK,.COMM.+=31 ;IF(J10/10.EQ.3)RC=-3
81900 IDIVI JK,=10
82000 CAIN JK,3
82100 MOVNI RC,3 ; RC=0 ESCAPES FRCOM LOOP.
82200 ;;; JRST HZ10
82300 ;;;H10: SETZ RC, ;FOR P13=1
82400 ; HOMING RANGE FOR BEAMS
82500 ;;;HZ10: MOVE IS,.COMM.+=12 ;10 IF(R11.EQ.0)R11=2.9
82600 H10: MOVE IS,.COMM.+=12 ;10 IF(R11.EQ.0)R11=2.9
82700 JUMPN IS,HX10
82800 MOVE IS,[=2.9]
82900 MOVEM IS,.COMM.+=12 ; IF P11.NE.0 RANGE IS CHANGED FROM 2
83000 HX10: MOVE IZ,.COMM.+1 ; IF(JA.EQ.5)RC=-1
83100 CAIN IZ,5
83200 MOVNI RC,1
83300 MOVEI K,1
83400 H361: JSA 16,FINDIT ;DO 361 K=1,ITEM
83500 JUMP K
83600 JUMPL 0,HX361 ;IF(FINDIT(K))GO TO 361
83700 ; SKIPS NOTES ON WRONG LINE
83800 MOVEI R,XRN ;RD=RN(L+3)
83900 ADD R,PTR+=251 ;LOC OF RN(L+1)
84000 MOVE A,2(R) ;RD IN A
84100 MOVEM A,XRN+=3999 ;1 IF(JA.NE.6)GO TO 177
84200 MOVE JK,.COMM.+1
84300 CAIE JK,6
84400 JRST H177
84500 MOVE JK,4(R) ;IF(IFIX(RN(L+5)/10).NE.X)GO TO 361
84600 FDVR JK,[=10.0]
84700 FIXX(J)
84800 CAME JK,IK
84900 JRST HX361
85000 H177: JSA 16,PLACE ;177 IF(PLACE(R3))GO TO 461
85100 JUMP .COMM.+4
85200 JUMPL H461
85300 MOVEM A,.COMM.+4 ;R3=RD
85400 ; LOOKS FOR NOTE, STAFF #, STEM DIR.
85500 MOVE JK,.COMM.+1 ;IF(JA.EQ.6)GO TO 861
85600 CAIN JK,6
85700 JRST H861
85800 CAIN JK,5 ;IF(JA.EQ.5)GO TO 261
85900 JRST H261
86000 JRA 16,(16) ;RETURN
86100 H461: MOVE JK,.COMM.+1 ;461 IF(JA.EQ.6)GO TO 277
86200 CAIN JK,6
86300 JRST H277
86400 CAIE JK,5 ;IF(JA.NE.5)GO TO 361
86500 JRST HX361
86600 H277: JSA 16,PLACE ;277 IF(PLACE(R6))GO TO 561
86700 JUMP .COMM.+7
86800 JUMPL H561
86900 MOVEM A,.COMM.+7 ;R6=RD
87000 H861: MOVE 0,.COMM.+=28 ;861 IF(J7.GE.0)GO TO 261
87100 JUMPGE 0,H261
87200 H561: JSA 16,PLACE ;561 IF(PLACE(RA))GO TO 661
87300 JUMP L
87400 JUMPL H661
87500 MOVE 0,.COMM.+=28 ;IF(J7)GO TO 761
87600 JUMPL H761 ; J7=NEG MEANS TREMOLO
87700 MOVE 0,.COMM.+=9 ; IF(R8.NE.0)GO TO 761
87800 JUMPN H761
87900 MOVE 0,.COMM.+=11 ; IF(R10.EQ.0)GO TO 361
88000 JUMPE HX361
88100 H761: MOVEM A,.COMM.+=10 ;761 R9=RD
88200 ; R8=0, R10=0 MEANS R9 IS NUMBER OUTSIDE OF BEAM.
88300 JRST H261 ;GO TO 261
88400 H661: CAIN JK,5 ;661 IF(JA.EQ.5)GO TO 361
88500 JRST HX361
88600 MOVE 0,.COMM.+=31 ;IF(J10.LT.30)GO TO 361
88700 CAIGE 0,=30
88800 JRST HX361
88900 JSA 16,PLACE ;IF(PLACE(R8))GO TO 361
89000 JUMP .COMM.+=9
89100 JUMPL HX361 ; HOMES INNER PARTIAL BEAMS
89200 MOVEM A,.COMM.+=9 ;R8=RD
89300 H261: SKIPN RC ;261 IF(RC.EQ.0)RETURN
89400 JRA 16,(16)
89500 AOJ RC ;RC=RC+1
89600 HX361: CAMGE K,PTR+=250 ;361 CONTINUE
89700 AOJA K,H361
89800 JRA 16,(16) ; END
89900
90000 ; CALL FSCAN
90100 ; GOTO RT
90200 ; GOTO LF
90300 ; GOTO UP
90400 ; GOTO DW
90500 ; GOTO 1/2
90600 ; GOTO *2
90700 ; GOTO X
90800 ; GOTO C
90900 ; ALL OTHERS(EXIT)
91000
91100 FSCAN: 0
91200 INCHRW
91300 CAIN ";"
91400 JRA 16,(16)
91500 CAIN ":"
91600 JRA 16,1(16)
91700 CAIN "("
91800 JRA 16,2(16)
91900 CAIN ")"
92000 JRA 16,3(16)
92100 CAIN "/"
92200 JRA 16,4(16)
92300 CAIN "*"
92400 JRA 16,5(16)
92500 CAIN "X"
92600 JRA 16,6(16)
92700 CAIN "C"
92800 JRA 16,7(16)
92900 JRA 16,8(16)
93000 END